home *** CD-ROM | disk | FTP | other *** search
/ Windows Game Programming for Dummies (2nd Edition) / WinGamProgFD.iso / pc / DirectX SDK / DXSDK / samples / Multimedia / VBSamples / Direct3D / Dolphin / Dolphin.frm (.txt) next >
Encoding:
Visual Basic Form  |  2001-10-08  |  26.4 KB  |  582 lines

  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    Caption         =   "Dolphin: Blending Meshes in Real Time"
  4.    ClientHeight    =   4290
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   5580
  8.    Icon            =   "dolphin.frx":0000
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   286
  11.    ScaleMode       =   3  'Pixel
  12.    ScaleWidth      =   372
  13.    StartUpPosition =   3  'Windows Default
  14. Attribute VB_Name = "Form1"
  15. Attribute VB_GlobalNameSpace = False
  16. Attribute VB_Creatable = False
  17. Attribute VB_PredeclaredId = True
  18. Attribute VB_Exposed = False
  19. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  20. '  Copyright (C) 1999-2001 Microsoft Corporation.  All Rights Reserved.
  21. '  File:       Dolphin.frm
  22. '  Content:    Sample of swimming dolphin
  23. '              This code uses the D3D Framework helper library.
  24. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  25. Option Explicit
  26. '-----------------------------------------------------------------------------
  27. ' Globals variables and definitions
  28. '-----------------------------------------------------------------------------
  29. Const WATER_COLOR = &H6688&
  30. Const AMBIENT_COLOR = &H33333333
  31. Const kMesh1 = 0
  32. Const kMesh2 = 1
  33. Const kMesh3 = 2
  34. 'Vertex type to be sent to D3D
  35. Private Type DOLPHINVERTEX
  36.     p As D3DVECTOR              'position of vertex
  37.     n As D3DVECTOR              'normal of vertex
  38.     tu As Single                'texture coordinate u
  39.     tv As Single                'texture coordinate v
  40. End Type
  41. 'VertexFormat to be sent to D3D to describe what
  42. 'elements DOLPHINVERTEX uses
  43. Const VertexFVF& = D3DFVF_XYZ Or D3DFVF_NORMAL Or D3DFVF_TEX1
  44. 'Helper structure to manage moving vertex information
  45. 'from d3dvertex buffers to a vb array
  46. Private Type MESHTOOL
  47.     VertB As Direct3DVertexBuffer8
  48.     NumVertices As Long
  49.     Vertices() As DOLPHINVERTEX
  50. End Type
  51. 'Dolphin objects
  52. Dim m_DolphinGroupObject As CD3DFrame   ' Frame that contains all mesh poses
  53. Dim m_DolphinMesh01 As CD3DMesh         ' Dolphin Mesh in pose 1
  54. Dim m_DolphinMesh02 As CD3DMesh         ' Dolphin Mesh in pose 2  (rest pose)
  55. Dim m_DolphinMesh03 As CD3DMesh         ' Dolphin Mesh in pose 3
  56. Dim m_DolphinObject As CD3DFrame        ' Frame that contains current pose
  57. Dim m_DolphinMesh As CD3DMesh           ' Dolphin Mesh in current pose
  58. Dim m_DolphinTex As Direct3DTexture8    ' Dolphin texture
  59. 'Seafloor objects
  60. Dim m_FloorObject As CD3DFrame          ' Frame that contains seafloor mesh
  61. Dim m_SeaFloorMesh As CD3DMesh          ' Seafloor Mesh
  62. Dim m_meshtool(3) As MESHTOOL           ' VertexInformation on the 3 poses
  63. Dim m_dest As MESHTOOL                  ' VertexInformation on the current pose
  64. 'Textures for the water caustics
  65. Dim m_CausticTextures() As Direct3DTexture8         ' Array of caustic textures
  66. Dim m_CurrentCausticTexture As Direct3DTexture8     ' Current texture
  67. Dim m_media As String                   ' Path to media
  68. Dim g_ftime As Single                   ' Current time in simulation
  69. Dim m_bInit As Boolean                  ' Indicates that d3d has been initialized
  70. Dim m_bMinimized As Boolean             ' Indicates that display window is minimized
  71. '-----------------------------------------------------------------------------
  72. ' Name: Form_Load()
  73. ' Desc: Main entry point for the sample
  74. '-----------------------------------------------------------------------------
  75. Private Sub Form_Load()
  76.     ' Show the form
  77.     Me.Show
  78.     DoEvents
  79.     ' Initialize D3D
  80.     ' Note: D3DUtil_Init will attempt to use D3D Hardware acceleartion.
  81.     ' If it is not available it attempt to use the Software Reference Rasterizer.
  82.     ' If all fail it will display a message box indicating so.
  83.     '
  84.     m_bInit = D3DUtil_Init(Me.hwnd, True, 0, 0, D3DDEVTYPE_HAL, Nothing)
  85.     If Not (m_bInit) Then End
  86.             
  87.     ' Find and set the path to our media
  88.     m_media = FindMediaDir("dolphin_group.x")
  89.     D3DUtil_SetMediaPath m_media
  90.     ' Create new D3D mesh objects and loads content from disk
  91.     InitDeviceObjects
  92.     ' Sets the state for those objects and the current D3D device
  93.     RestoreDeviceObjects
  94.     ' Start our timer
  95.     DXUtil_Timer TIMER_start
  96.     ' Run the simulation forever
  97.     ' See Form_Keydown for exit processing
  98.     Do While True
  99.         ' Increment the simulation
  100.         FrameMove
  101.         
  102.         ' Render one image of the simulation
  103.         If Render Then 'It was successfull
  104.             
  105.             ' Present the image to the screen
  106.             D3DUtil_PresentAll g_focushwnd
  107.         End If
  108.         
  109.         ' Allow for events to get processed
  110.         DoEvents
  111.         
  112.     Loop
  113. End Sub
  114. '-----------------------------------------------------------------------------
  115. ' Name: Form_KeyDown()
  116. ' Desc: Process key messages for exit and change device
  117. '-----------------------------------------------------------------------------
  118. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  119.      Select Case KeyCode
  120.         
  121.         Case vbKeyEscape
  122.             Unload Me
  123.             
  124.         Case vbKeyF2
  125.                 
  126.             ' Pause the timer
  127.             DXUtil_Timer TIMER_STOP
  128.             
  129.             ' Bring up the device selection dialog
  130.             ' we pass in the form so the selection process
  131.             ' can make calls into InitDeviceObjects
  132.             ' and RestoreDeviceObjects
  133.             frmSelectDevice.SelectDevice Me
  134.             
  135.             ' Restart the timer
  136.             DXUtil_Timer TIMER_start
  137.             
  138.         Case vbKeyReturn
  139.         
  140.             ' Check for Alt-Enter if not pressed exit
  141.             If Shift <> 4 Then Exit Sub
  142.             
  143.             ' If we are windowed go fullscreen
  144.             ' If we are fullscreen returned to windowed
  145.             If g_d3dpp.Windowed Then
  146.                  D3DUtil_ResetFullscreen
  147.             Else
  148.                  D3DUtil_ResetWindowed
  149.             End If
  150.                              
  151.             ' Call Restore after ever mode change
  152.             ' because calling reset looses state that needs to
  153.             ' be reinitialized
  154.             RestoreDeviceObjects
  155.            
  156.     End Select
  157. End Sub
  158. '-----------------------------------------------------------------------------
  159. ' Name: Form_Resize()
  160. ' Desc: hadle resizing of the D3D backbuffer
  161. '-----------------------------------------------------------------------------
  162. Private Sub Form_Resize()
  163.     ' If D3D is not initialized then exit
  164.     If Not m_bInit Then Exit Sub
  165.     ' If we are in a minimized state stop the timer and exit
  166.     If Me.WindowState = vbMinimized Then
  167.         DXUtil_Timer TIMER_STOP
  168.         m_bMinimized = True
  169.         Exit Sub
  170.         
  171.     ' If we just went from a minimized state to maximized
  172.     ' restart the timer
  173.     Else
  174.         If m_bMinimized = True Then
  175.             DXUtil_Timer TIMER_start
  176.             m_bMinimized = False
  177.         End If
  178.     End If
  179.     ' Dont let the window get too small
  180.     If Me.ScaleWidth < 10 Then
  181.         Me.width = Screen.TwipsPerPixelX * 10
  182.         Exit Sub
  183.     End If
  184.     If Me.ScaleHeight < 10 Then
  185.         Me.height = Screen.TwipsPerPixelY * 10
  186.         Exit Sub
  187.     End If
  188.     'reset and resize our D3D backbuffer to the size of the window
  189.     D3DUtil_ResizeWindowed Me.hwnd
  190.     'All state get losts after a reset so we need to reinitialze it here
  191.     RestoreDeviceObjects
  192. End Sub
  193. '-----------------------------------------------------------------------------
  194. ' Name: Form_Unload()
  195. ' Desc:
  196. '-----------------------------------------------------------------------------
  197. Private Sub Form_Unload(Cancel As Integer)
  198.     DeleteDeviceObjects
  199.     End
  200. End Sub
  201. '-----------------------------------------------------------------------------
  202. ' Name: InitDeviceObjects()
  203. ' Desc: Create mesh and texture objects
  204. '-----------------------------------------------------------------------------
  205. Function InitDeviceObjects() As Boolean
  206.     Dim b As Boolean
  207.     Dim t As Long
  208.     Dim strName As String
  209.     Dim i As Long
  210.         
  211.      
  212.     'Allocate an array for the caustic textures
  213.     ReDim m_CausticTextures(32)
  214.         
  215.     'Load caustic textures into an array
  216.     For t = 0 To 31
  217.         strName = m_media + "Caust" + format$(t, "00") + ".tga"
  218.         Set m_CausticTextures(t) = D3DUtil_CreateTexture(g_dev, strName, D3DFMT_UNKNOWN)
  219.         If m_CausticTextures(t) Is Nothing Then Debug.Print "Unable to find media " + strName
  220.     Next
  221.     ' Load the file-based mesh objects
  222.     Set m_DolphinGroupObject = D3DUtil_LoadFromFile(m_media + "dolphin_group.x", Nothing, Nothing)
  223.     Set m_DolphinObject = D3DUtil_LoadFromFile(m_media + "dolphin.x", Nothing, Nothing)
  224.     Set m_FloorObject = D3DUtil_LoadFromFile(m_media + "seafloor.x", Nothing, Nothing)
  225.     '  Gain access to the meshes from the parent frames
  226.     Set m_DolphinMesh01 = m_DolphinGroupObject.FindChildObject("Dolph01", 0)
  227.     Set m_DolphinMesh02 = m_DolphinGroupObject.FindChildObject("Dolph02", 0)
  228.     Set m_DolphinMesh03 = m_DolphinGroupObject.FindChildObject("Dolph03", 0)
  229.     Set m_DolphinMesh = m_DolphinObject.FindChildObject("Dolph02", 0).GetChildMesh(0)
  230.     Set m_SeaFloorMesh = m_FloorObject.FindChildObject("SeaFloor", 0)
  231.     ' Set the FVF (flexible vertex format) to one we reconginze
  232.     Call m_DolphinMesh01.SetFVF(g_dev, VertexFVF)
  233.     Call m_DolphinMesh02.SetFVF(g_dev, VertexFVF)
  234.     Call m_DolphinMesh03.SetFVF(g_dev, VertexFVF)
  235.     Call m_DolphinMesh.SetFVF(g_dev, VertexFVF)
  236.     Call m_SeaFloorMesh.SetFVF(g_dev, VertexFVF)
  237.     ' Load the texture for the dolphin's skin
  238.     Set m_DolphinTex = D3DUtil_CreateTexture(g_dev, m_media + "dolphin.bmp", D3DFMT_UNKNOWN)
  239.     ' The folowing scales the sea floor vertices, and adds some bumpiness
  240.     Dim seafloortool As MESHTOOL
  241.     ' Meshtool init copies mesh vertices from the mesh object into the
  242.     ' seafloortool.vertices array
  243.     MESHTOOL_INIT seafloortool, m_SeaFloorMesh.mesh
  244.     ' Loop through  and modify height (y) of vertices
  245.     For i = 0 To seafloortool.NumVertices - 1
  246.        seafloortool.Vertices(i).p.y = seafloortool.Vertices(i).p.y + Rnd(1) + Rnd(1) + Rnd(1)
  247.        seafloortool.Vertices(i).tu = seafloortool.Vertices(i).tu * 10
  248.        seafloortool.Vertices(i).tv = seafloortool.Vertices(i).tv * 10
  249.     Next
  250.     ' Save modified vertices back to the vertex buffer and cleanup seafloortool object
  251.     D3DVertexBuffer8SetData seafloortool.VertB, 0, Len(seafloortool.Vertices(0)) * seafloortool.NumVertices, 0, seafloortool.Vertices(0)
  252.     MESHTOOL_DESTROY seafloortool
  253.     ' Extract vertex information for the 3 dolphin poses
  254.     MESHTOOL_INIT m_meshtool(kMesh1), m_DolphinMesh01.mesh
  255.     MESHTOOL_INIT m_meshtool(kMesh2), m_DolphinMesh02.mesh
  256.     MESHTOOL_INIT m_meshtool(kMesh3), m_DolphinMesh03.mesh
  257.     ' size Vertices array for the current pose
  258.     MESHTOOL_INIT m_dest, m_DolphinMesh.mesh
  259.     InitDeviceObjects = True
  260.         
  261. End Function
  262. '-----------------------------------------------------------------------------
  263. ' Name: RestoreDeviceObjects()
  264. ' Desc: Restore device-memory objects and state after a device is created or
  265. '       resized.
  266. '-----------------------------------------------------------------------------
  267. Public Sub RestoreDeviceObjects()
  268.     'Restore Mesh objects
  269.     m_DolphinGroupObject.RestoreDeviceObjects g_dev
  270.     m_DolphinObject.RestoreDeviceObjects g_dev
  271.     m_FloorObject.RestoreDeviceObjects g_dev
  272.         
  273.     With g_dev
  274.         
  275.         ' Set world transform
  276.         Dim matWorld As D3DMATRIX
  277.         D3DXMatrixIdentity matWorld
  278.         .SetTransform D3DTS_WORLD, matWorld
  279.        ' Set the  view matrix for normal viewing
  280.         Dim vEyePt As D3DVECTOR, vLookatPt As D3DVECTOR, vUpVec As D3DVECTOR
  281.         Dim matView As D3DMATRIX
  282.         vEyePt = vec3(0, 0, -5)
  283.         vLookatPt = vec3(0, 0, 0)
  284.         vUpVec = vec3(0, 1, 0)
  285.         D3DXMatrixLookAtLH matView, vEyePt, vLookatPt, vUpVec
  286.         .SetTransform D3DTS_VIEW, matView
  287.         
  288.         ' Set the projection matrix
  289.         Dim matProj As D3DMATRIX
  290.         Dim fAspect As Single
  291.         fAspect = Me.ScaleHeight / Me.ScaleWidth
  292.         D3DXMatrixPerspectiveFovLH matProj, g_pi / 3, fAspect, 1, 10000
  293.         .SetTransform D3DTS_PROJECTION, matProj
  294.         ' Set texture stages to modulate the diffuse color with the texture color
  295.         .SetTextureStageState 0, D3DTSS_COLORARG1, D3DTA_TEXTURE
  296.         .SetTextureStageState 0, D3DTSS_COLORARG2, D3DTA_DIFFUSE
  297.         .SetTextureStageState 0, D3DTSS_COLOROP, D3DTOP_MODULATE
  298.         .SetTextureStageState 0, D3DTSS_MINFILTER, D3DTEXF_LINEAR
  299.         .SetTextureStageState 0, D3DTSS_MAGFILTER, D3DTEXF_LINEAR
  300.         .SetTextureStageState 1, D3DTSS_MINFILTER, D3DTEXF_LINEAR
  301.         .SetTextureStageState 1, D3DTSS_MAGFILTER, D3DTEXF_LINEAR
  302.         ' Set default render states
  303.         .SetRenderState D3DRS_DITHERENABLE, 1 'True
  304.         .SetRenderState D3DRS_SPECULARENABLE, 0 'False
  305.         .SetRenderState D3DRS_ZENABLE, 1 'True
  306.         .SetRenderState D3DRS_NORMALIZENORMALS, 1 'True
  307.         ' Turn on fog, for underwater effect
  308.         Dim fFogStart  As Single
  309.         Dim fFogEnd As Single
  310.         fFogStart = 1
  311.         fFogEnd = 50
  312.         .SetRenderState D3DRS_FOGENABLE, 1 ' True
  313.         .SetRenderState D3DRS_FOGCOLOR, WATER_COLOR
  314.         .SetRenderState D3DRS_FOGTABLEMODE, D3DFOG_NONE
  315.         .SetRenderState D3DRS_FOGVERTEXMODE, D3DFOG_LINEAR
  316.         .SetRenderState D3DRS_RANGEFOGENABLE, 0 'False
  317.         .SetRenderState D3DRS_FOGSTART, FtoDW(fFogStart)
  318.         .SetRenderState D3DRS_FOGEND, FtoDW(fFogEnd)
  319.             
  320.         ' Create a directional light pointing straight down
  321.         Dim light As D3DLIGHT8
  322.         D3DUtil_InitLight light, D3DLIGHT_DIRECTIONAL, 0, -1, 0
  323.         .SetLight 0, light
  324.         .LightEnable 0, 1 'True
  325.         .SetRenderState D3DRS_LIGHTING, 1 'TRUE
  326.         .SetRenderState D3DRS_AMBIENT, AMBIENT_COLOR
  327.     End With
  328. End Sub
  329. '-----------------------------------------------------------------------------
  330. ' Name: MESHTOOL_INIT()
  331. ' Desc:
  332. '-----------------------------------------------------------------------------
  333. Private Sub MESHTOOL_INIT(mt As MESHTOOL, m As D3DXMesh)
  334.     Set mt.VertB = m.GetVertexBuffer
  335.     mt.NumVertices = m.GetNumVertices
  336.     ReDim mt.Vertices(mt.NumVertices)
  337.     D3DVertexBuffer8GetData mt.VertB, 0, mt.NumVertices * Len(mt.Vertices(0)), 0, mt.Vertices(0)
  338. End Sub
  339. '-----------------------------------------------------------------------------
  340. ' Name: MESHTOOL_DESTROY()
  341. ' Desc:
  342. '-----------------------------------------------------------------------------
  343. Private Sub MESHTOOL_DESTROY(mt As MESHTOOL)
  344.    Set mt.VertB = Nothing
  345.    ReDim mt.Vertices(0)
  346. End Sub
  347. '-----------------------------------------------------------------------------
  348. ' Name: FrameMove()
  349. ' Desc: Called once per image frame, the call is the entry point for animating
  350. '       the scene.
  351. '-----------------------------------------------------------------------------
  352. Sub FrameMove()
  353.     'Dont do anything if in a minimized state
  354.     If m_bMinimized = True Then Exit Sub
  355.     'Get the time as a single
  356.     g_ftime = DXUtil_Timer(TIMER_GETAPPTIME) * 0.9
  357.     Dim fKickFreq As Single, fPhase As Single, fBlendWeight As Single
  358.     'compute time based inputs
  359.     fKickFreq = g_ftime * 2
  360.     fPhase = g_ftime / 3
  361.     fBlendWeight = Sin(fKickFreq)
  362.     ' Blend the meshes (which makes the dolphin appear to swim)
  363.     Call BlendMeshes(fBlendWeight)
  364.     ' Move the dolphin in a circle and have it undulate
  365.     Dim vTrans As D3DVECTOR
  366.     Dim qRot As D3DQUATERNION
  367.     Dim matDolphin As D3DMATRIX
  368.     Dim matTrans As D3DMATRIX, matRotate1 As D3DMATRIX, matRotate2 As D3DMATRIX
  369.     'Scale dolphin geometery to 1/100 original
  370.     D3DXMatrixScaling matDolphin, 0.01, 0.01, 0.01
  371.     'add up and down roation (since modeled along x axis)
  372.     D3DXMatrixRotationZ matRotate1, -Cos(fKickFreq) / 6
  373.     D3DXMatrixMultiply matDolphin, matDolphin, matRotate1
  374.     'add rotation to make dolphin point at tangent to the circle
  375.     D3DXMatrixRotationY matRotate2, fPhase
  376.     D3DXMatrixMultiply matDolphin, matDolphin, matRotate2
  377.     'add traslation to make the dolphin move in a circle and bob up and down
  378.     'in sync with its flippers
  379.     D3DXMatrixTranslation matTrans, -5 * Sin(fPhase), Sin(fKickFreq) / 2, 10 - 10 * Cos(fPhase)
  380.     D3DXMatrixMultiply matDolphin, matDolphin, matTrans
  381.         
  382.     m_DolphinObject.SetMatrix matDolphin
  383.     ' Animate the caustic textures
  384.     Dim tex As Long
  385.     tex = CLng((g_ftime * 32)) Mod 32
  386.     Set m_CurrentCausticTexture = m_CausticTextures(tex)
  387. End Sub
  388. '-----------------------------------------------------------------------------
  389. ' Name: BlendMeshes()
  390. ' Desc: Does a linear interpolation between all vertex positions and normals
  391. '       in two source meshes and outputs the result to the destination mesh.
  392. '       Note: all meshes must contain the same number of vertices, and the
  393. '       destination mesh must be in device memory.
  394. '-----------------------------------------------------------------------------
  395. Sub BlendMeshes(ByVal fWeight As Single)
  396.     Dim fWeight1 As Single, fWeight2 As Single
  397.     Dim vTemp1 As D3DVECTOR, vTemp2 As D3DVECTOR
  398.     Dim i As Long, j As Long
  399.     If (fWeight < 0) Then
  400.         j = kMesh3
  401.     Else
  402.         j = kMesh1
  403.     End If
  404.      
  405.     ' compute blending factors
  406.     fWeight1 = fWeight
  407.     If fWeight < 0 Then fWeight1 = -fWeight1
  408.     fWeight2 = 1 - fWeight1
  409.     ' Linearly Interpolate (LERP)positions and normals
  410.     For i = 0 To m_dest.NumVertices - 1
  411.         D3DXVec3Scale vTemp1, m_meshtool(kMesh2).Vertices(i).p, fWeight2
  412.         D3DXVec3Scale vTemp2, m_meshtool(j).Vertices(i).p, fWeight1
  413.         D3DXVec3Add m_dest.Vertices(i).p, vTemp1, vTemp2
  414.         
  415.         D3DXVec3Scale vTemp1, m_meshtool(kMesh2).Vertices(i).n, fWeight2
  416.         D3DXVec3Scale vTemp2, m_meshtool(j).Vertices(i).n, fWeight1
  417.         D3DXVec3Add m_dest.Vertices(i).n, vTemp1, vTemp2
  418.     Next
  419.     'Copy the data into the d3dvertex buffer
  420.     D3DVertexBuffer8SetData m_dest.VertB, 0, m_dest.NumVertices * Len(m_dest.Vertices(0)), 0, m_dest.Vertices(0)
  421. End Sub
  422. '-----------------------------------------------------------------------------
  423. ' Name: Render()
  424. ' Desc: Called once per frame, the call is the entry point for 3d
  425. '       rendering. This function sets up render states, clears the
  426. '       viewport, and renders the scene.
  427. '-----------------------------------------------------------------------------
  428. Function Render() As Boolean
  429.     'Dont do anything if in a minimized state
  430.     If m_bMinimized = True Then Exit Function
  431.     On Local Error Resume Next
  432.     Dim mat As D3DMATRIX
  433.     Dim mat2 As D3DMATRIX
  434.     Dim hr As Long
  435.     Render = False
  436.     'See what state the device is in.
  437.     hr = g_dev.TestCooperativeLevel
  438.     If hr = D3DERR_DEVICENOTRESET Then
  439.         g_dev.Reset g_d3dpp
  440.         RestoreDeviceObjects
  441.     ElseIf hr <> 0 Then 'dont bother rendering if we are not ready yet
  442.         Exit Function
  443.     End If
  444.     Render = True
  445.     ' Clear the backbuffer
  446.     D3DUtil_ClearAll WATER_COLOR
  447.     With g_dev
  448.         .BeginScene
  449.                         
  450.         ' Render the Seafloor. For devices that support one-pass multi-
  451.         ' texturing, use the second texture stage to blend in the animated
  452.         ' water caustics texture.
  453.         If (g_d3dCaps.MaxTextureBlendStages > 1) Then
  454.             ' Set up the 2nd texture stage for the animated water caustics
  455.             .SetTexture 1, m_CurrentCausticTexture
  456.             .SetTextureStageState 1, D3DTSS_COLOROP, D3DTOP_MODULATE
  457.             .SetTextureStageState 1, D3DTSS_COLORARG1, D3DTA_TEXTURE
  458.             .SetTextureStageState 1, D3DTSS_COLORARG2, D3DTA_CURRENT
  459.             ' Tell D3D to automatically generate texture coordinates from the
  460.             ' model's position in camera space. The texture transform matrix is
  461.             ' setup so that the 'x' and 'z' coordinates are scaled to become the
  462.             ' resulting 'tu' and 'tv' texture coordinates. The resulting effect
  463.             ' is that the caustic texture is draped over the geometry from above.
  464.             mat.m11 = 0.05:           mat.m12 = 0#
  465.             mat.m21 = 0#:             mat.m22 = 0#
  466.             mat.m31 = 0#:             mat.m32 = 0.05
  467.             mat.m41 = Sin(g_ftime) / 8: mat.m42 = (Cos(g_ftime) / 10) - (g_ftime / 10)
  468.             .SetTransform D3DTS_TEXTURE1, mat
  469.             .SetTextureStageState 1, D3DTSS_TEXCOORDINDEX, D3DTSS_TCI_CAMERASPACEPOSITION
  470.             .SetTextureStageState 1, D3DTSS_TEXTURETRANSFORMFLAGS, D3DTTFF_COUNT2
  471.         End If
  472.         g_dev.SetRenderState D3DRS_AMBIENT, &HB0B0B0B0
  473.         
  474.         
  475.         ' Finally, render the actual seafloor with the above states
  476.         m_FloorObject.Render g_dev
  477.         
  478.         
  479.         ' Disable the second texture stage
  480.         If (g_d3dCaps.MaxTextureBlendStages > 1) Then
  481.             .SetTextureStageState 1, D3DTSS_COLOROP, D3DTOP_DISABLE
  482.         End If
  483.         ' Render the dolphin in it's first pass.
  484.         .SetRenderState D3DRS_AMBIENT, AMBIENT_COLOR
  485.         m_DolphinObject.Render g_dev
  486.         ' For devices that support one-pass multi-texturing, use the second
  487.         ' texture stage to blend in the animated water caustics texture for
  488.         ' the dolphin. This a little tricky because we only want caustics on
  489.         ' the part of the dolphin that is lit from above. To acheive this
  490.         ' effect, the dolphin is rendered alpha-blended with a second pass
  491.         ' which has the caustic effects modulating the diffuse component
  492.         '  which contains lighting-only information) of the geometry.
  493.         If (g_d3dCaps.MaxTextureBlendStages > 1) Then
  494.             ' For the 2nd pass of rendering the dolphin, turn on the caustic
  495.             ' effects. Start with setting up the 2nd texture stage state, which
  496.             ' will modulate the texture with the diffuse component. This actually
  497.             ' only needs one stage, except that using a CD3DFile object makes that
  498.             ' a little tricky.
  499.             .SetTexture 1, m_CurrentCausticTexture
  500.             .SetTextureStageState 1, D3DTSS_COLOROP, D3DTOP_MODULATE
  501.             .SetTextureStageState 1, D3DTSS_COLORARG1, D3DTA_TEXTURE
  502.             .SetTextureStageState 1, D3DTSS_COLORARG2, D3DTA_DIFFUSE
  503.             ' Now, set up D3D to generate texture coodinates. This is the same as
  504.             ' with the seafloor  the 'x' and 'z' position coordinates in camera
  505.             ' space are used to generate the 'tu' and 'tv' texture coordinates),
  506.             ' except our scaling factors are different in the texture matrix, to
  507.             ' get a better looking result.
  508.             mat2.m11 = 0.5: mat2.m12 = 0#
  509.             mat2.m21 = 0#: mat2.m22 = 0#
  510.             mat2.m31 = 0#: mat2.m32 = 0.5
  511.             mat2.m41 = 0#: mat2.m42 = 0#
  512.             .SetTransform D3DTS_TEXTURE1, mat2
  513.             .SetTextureStageState 1, D3DTSS_TEXCOORDINDEX, D3DTSS_TCI_CAMERASPACEPOSITION
  514.             .SetTextureStageState 1, D3DTSS_TEXTURETRANSFORMFLAGS, D3DTTFF_COUNT2
  515.             ' Set the ambient color and fog color to pure black. Ambient is set
  516.             ' to black because we still have a light shining from above, but we
  517.             ' don't want any caustic effects on the dolphin's underbelly. Fog is
  518.             ' set to black because we want the caustic effects to fade out in the
  519.             ' distance just as the model does with the WATER_COLOR.
  520.             .SetRenderState D3DRS_AMBIENT, &H0&
  521.             .SetRenderState D3DRS_FOGCOLOR, &H0&
  522.             ' Set up blending modes to add this caustics-only pass with the
  523.             ' previous pass.
  524.             .SetRenderState D3DRS_ALPHABLENDENABLE, 1 ' True
  525.             .SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCCOLOR
  526.             .SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE
  527.             ' Finally, render the caustic effects for the dolphin
  528.             m_DolphinObject.Render g_dev
  529.             ' After all is well and done, restore any munged texture stage states
  530.             .SetTextureStageState 1, D3DTSS_COLOROP, D3DTOP_DISABLE
  531.             .SetRenderState D3DRS_AMBIENT, AMBIENT_COLOR
  532.             .SetRenderState D3DRS_FOGCOLOR, WATER_COLOR
  533.             .SetRenderState D3DRS_ALPHABLENDENABLE, 0 'False
  534.         End If
  535. skipcaustic:
  536.         ' End the scene.
  537.         .EndScene
  538.     End With
  539. End Function
  540. '-----------------------------------------------------------------------------
  541. ' Name: InvalidateDeviceObjects()
  542. ' Desc: Called when the device-dependant objects are about to be lost.
  543. '-----------------------------------------------------------------------------
  544. Public Sub InvalidateDeviceObjects()
  545.     m_FloorObject.InvalidateDeviceObjects
  546.     m_DolphinGroupObject.InvalidateDeviceObjects
  547.     m_DolphinObject.InvalidateDeviceObjects
  548. End Sub
  549. '-----------------------------------------------------------------------------
  550. ' Name: DeleteDeviceObjects()
  551. ' Desc: Called when the app is exitting, or the device is being changed,
  552. '       this function deletes any device dependant objects.
  553. '-----------------------------------------------------------------------------
  554. Public Sub DeleteDeviceObjects()
  555.     m_FloorObject.Destroy
  556.     m_DolphinGroupObject.Destroy
  557.     m_DolphinObject.Destroy
  558.     MESHTOOL_DESTROY m_meshtool(0)
  559.     MESHTOOL_DESTROY m_meshtool(1)
  560.     MESHTOOL_DESTROY m_meshtool(2)
  561.     MESHTOOL_DESTROY m_dest
  562.     Set m_DolphinGroupObject = Nothing
  563.     Set m_DolphinObject = Nothing
  564.     Set m_DolphinMesh = Nothing
  565.     Set m_DolphinMesh01 = Nothing
  566.     Set m_DolphinMesh02 = Nothing
  567.     Set m_DolphinMesh03 = Nothing
  568.     Set m_FloorObject = Nothing
  569.     Set m_SeaFloorMesh = Nothing
  570.     Set m_DolphinTex = Nothing
  571.     ReDim m_CausticTextures(0)
  572.     Set m_CurrentCausticTexture = Nothing
  573.     m_bInit = False
  574. End Sub
  575. '-----------------------------------------------------------------------------
  576. ' Name: VerifyDevice()
  577. ' Desc: Called when the app is trying to find valid display modes
  578. '-----------------------------------------------------------------------------
  579. Public Function VerifyDevice(usageflags As Long, format As CONST_D3DFORMAT) As Boolean
  580.     VerifyDevice = True
  581. End Function
  582.